00100		TITLE SLOOP
00200		ENTRY RNOTE,DRWNT,RDRAW,SLOOP,CIRCLE,PSRT,RUNTHR
00300		EXTERNAL PTR,XRN,STF,.COMM.,CLEFS,AMOD,LINES,ALF,SLR
00400		EXTERNAL EXP3.2,SIN,COS,ATAN2,PLTR,SIND,COSD
00500		DEFINE FIXX(N)
00600	<	JUMPGE	N,.+5
00700		MOVNS	N
00800		FIX 	N,233000    
00900		MOVNS	N
01000		CAIA
01100		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01200	
01300		RB←15↔RX←14↔RA←13↔R←12↔KK←11↔LL←10↔RW←7↔RZ←6↔SY←5
01400	SLOOP:	0
01500		MOVE	RB,.COMM.+=18	;RB=RX/71.
01600		FDVR	RB,[=71.0]
01700		SETZ	KK,	;DO 81 K=0,71
01710		SETZ RX,
01800	SLR81:	MOVE	RA,RX
01900		FADR RX,[1.0]
02100		FMPR	RA,RB
02200		FADR	RA,.COMM.+4	;81	SLURX(K+1)=RB*(K)+R3
02550		MOVEM RA,SLR(KK)
02600		CAIGE	KK,=71
02700		AOJA	KK,SLR81
02800		MOVE	RA,.COMM.+=8	;RA=R7*RST7
02900		FMPR	RA,.COMM.+=17
03000		SKIPN	RX,.COMM.+=10	;41	IF(R9.EQ.0)R9=RZZ
03100		MOVE	RX,[=2.8]	;RX IS R9
03200	SLR41:	MOVE	R,.COMM.+2	;R=R+RA    CENTR IS R
03300		FADR	R,RA
03400		SETZ	LL,		;L=0
03410		MOVE KK,[36.0]		;JS=36
03420		SKIPL .COMM.+=41	;IF(RJ)JS=72
03430		MOVE KK,[72.0]		;DO 40 K=JS,1,-1
03500		MOVEM KK,RNOTE		;RNOTE=JS  SAVE IT FOR DIVIDE LATER
03600		MOVNS	RA
03602		MOVE [1.0]
03604		MOVNM DRWNT		;DRWNT=-1. THE INCREMENT
03606		MOVEM PSRT		; THE GOAL
03610		MOVE .COMM.+=41		;IF(RJ.LT.200)GO TO SLR40
03620		CAMGE [200.0]
03630		JRST SLR40
03640		EXCH  KK,PSRT		;PSRT=JS AND JS=PSRT
03650		MOVNS DRWNT		; THE INCREMENT IS NOW POS.
03700	SLR40:	AOJ	LL,		;L=L+1
03800		MOVE	2,KK		;RW=R-RA*(K/RNOTE)**R9
03900		FDVR	2,RNOTE  
03910		CAML 2,[0.1]	;NEXT IS TO AVOID UNDERFLOW IN EXP3.2
03920		JRST .+3
03930		MOVEM R,ALF(LL)
03940		JRST UNDER
04000		MOVE	3,RX
04100		PUSHJ	17,EXP3.2	; I HOPE! AC2=AC2**AC3
04200		FMPR	2,RA
04300		MOVE	RW,2
04400		FADR	RW,R
04500					;SLURY(L)=RW
04700					;ALF IS 1 BEFORE SLURY(1)
04750		MOVEM RW,ALF(LL)
04775	UNDER:	MOVE .COMM.+=41		;IF(RJ.GT.0)GO TO 40
04787		JUMPG RJ40
04800		MOVE	2,[=73]		;SLURY(73-L)=RW
04900		SUBI	2,(LL)
05250		MOVEM RW,ALF(2)
05300	;;RJ40:	FSBR	KK,[=1.0]	;40 CONTINUE
05310	RJ40:	CAMN KK,PSRT	;40 CONTINUE	WE ARE GOING + OR - THRU ARRAY
05320		JRST .+3
05330		FADR KK,DRWNT		; ADD THE INCREMENT (OR SUBTRACT)
05340		JRST SLR40		; LOOP BACK
05400	;;	JUMPG	KK,SLR40
05500	
05600		MOVE	2,.COMM.+=20	;89	IF(RTILT.EQ.0)GO TO 87
05700		JUMPE	2,SLR87		;RETURNS
05800		JSA	16,ATAN2	;RW=ATAN2(RTILT,RXX)
05900		JUMP	.COMM.+=20
06000		JUMP	.COMM.+=19
06100		MOVE	RW,0
06200		JSA	16,SIN		;RA=SIN(RW)
06300		JUMP	RW		; ????
06400		MOVE	RA,0
06500		JSA	16,COS		;RB=COS(RW)
06600		JUMP	RW
06700		MOVE	RB,0
06800		MOVE	RZ,SLR		;RZ=SLURX(1)
06900		MOVE	RW,ALF+1		;RW=SLURY(1)
07000		MOVEI	KK,SLR		;DO 83 K=1,L
07100		MOVEI	4,=72
07200		ADDI	4,-1(KK)	;ADR. OF SLURX(L+1)
07300		MOVEI	SY,ALF+1
07400	SLR83:	MOVE	R,(KK)	;R=SLURX(K)-RZ
07500		FSBR	R,RZ
07600		MOVE	RX,(SY)		;RXX=SLURY(K)-RW
07700		FSBR	RX,RW
07800		MOVN	2,RA	;SLURX(K)=RB*R-RA*RXX+RZ
07900		FMPR	2,RX
08000		FADR	2,RZ
08100		MOVE	3,R
08200		FMPR	3,RB
08300		FADR 	3,2
08400		MOVEM	3,(KK)
08500		MOVE	2,RA		;83	SLURY(K)=RB*RXX+RA*R+RW
08600		FMPR	2,R
08700		FADR	2,RW
08800		MOVE	3,RX
08900		FMPR	3,RB
09000		FADR	3,2
09100		MOVEM	3,(SY)
09200		AOJ	SY,
09300		CAIGE	KK,(4)
09400		AOJA	KK,SLR83
09500	SLR87:	JRA	16,(16)
09600	A:	0
09700	B:	0
09800	L:	0
09900	
10000	RNOTE:	0	;	SUBROUTINE RNOTE(X)
10100		MOVE	2,@(16)	;COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
10200		JSA	16,AMOD	;X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
10300		JUMP	2
10400		JUMP	[=1000.0]
10500		MOVE	2,0
10600		FIXX(2)
10700	;;	MOVEI	3,PTR
10800	;;	ADDI	3,(2)		;END
10900	;;	MOVE	3,-1(3)
10950		MOVE 3,PTR-1(2)
11000	;X	FIXX(3)
11100	;;	MOVEI	2,XRN
11200	;;	ADDI	2,(3)
11300	;;	MOVE	3,-1(2)
11350		MOVE 3,XRN-1(3)
11400		MOVEM	3,@(16)
11500		JSA	16,1(16)
11600	
11700	DRWNT:	0   	;	SUBROUTINE DRWNT(RMINI)
11800		MOVE	5,.COMM.+2	;COMMON /STF/RSTFAC(-3/4),RSTJ2
11900		MOVEM	5,A
12000		SETZM	.COMM.+=29	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)	
12100		MOVE	7,.COMM.+=26;EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
12200		MOVEM	7,B
12300		MOVE	6,.COMM.+7 ;1(JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
12400		MOVEM	6,L
12500	;;	MOVE	10,.COMM.+=8 ;1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
12600	;;	MOVEM	10,SLOOP
12700		MOVE	2,@(16)		;RJX=CENTR
12800		FMPR	2,[=0.5]	;JH=0  J8
12900	;  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
13000		FDVR	2,STF+=8	;RA=R6
13100		MOVEM	2,.COMM.+7		;R6=.5*RMINI/RSTJ2
13200		MOVEM	2,.COMM.+=8		;R7=R6
13300		MOVE	2,.COMM.+=23	;RJD=RJZ-3
13400		FSBR	2,[=3.0]
13500		MOVEM	2,.COMM.+5
13600	;  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
13700	;;	MOVE	11,.COMM.+=30
13800	;;	MOVEM	11,RNOTE
13900		SETZM	.COMM.+=30		;JI=0
14000		JSA	16,CLEFS	;CALL CLEFS
14100		MOVE	11,.COMM.+=10
14200		FIXX(11)
14300		MOVEM	11,.COMM.+=30	;JI=R9  (I SAVED JI IN 11)
14400	;  ↑↑↑↑↑↑ NEEDED??
14500	;  FOR WHITE NOTES AND ACCIS ON PLOTTER.
14600		MOVE	5,A
14700		MOVEM	5,.COMM.+2		;CENTR=RJX
14800		MOVE	6,L
14900		MOVEM	6,.COMM.+7		;R6=RA
15000		MOVE	7,.COMM.+=28
15100		TLC	7,232000
15200		FADR	7,7
15300		MOVEM	7,.COMM.+=8	;R7=JG
15400		MOVE	10,.COMM.+6
15500		FIXX(10)
15600		MOVEM	10,.COMM.+=26	;JE=RJE	
15700		JRA	16,1(16)	;END	(ALIGNMENT ABOVE IS OFF!)
15800	
15900	RDRAW:	0  ;	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
16000		MOVEI	2,@2(16) ;C   TO X,Y INTO ONE WORD
16100		ADD	2,@(16)		;DIMENSION XY(1)
16200		MOVE	3,@1(16)	;DO 2 K=I,IFIX(S)
16300		FIXX(3)
16400		MOVEI	10,@2(16)
16500		ADDI	10,(3)
16600		MOVEM	10,DRWNT	;SAVE IT FOR NOW
16700	RD2:	MOVEI	4,2		; L=2
16800		MOVE	5,-1(2)		; Y=XY(K)
16900		CAMGE	5,[=1000.0]	;IF(Y.LT.1000.)GO TO 3
17000		JRST	RD3
17100		MOVEI	4,3		;L=3
17200		FSBR	5,[=1000.0]	;Y=Y-1000.
17300	;   >1000 = INVIS. LINE
17400	RD3:	MOVE	6,5	;3	M=Y
17500		MOVEM	4,L
17600		FIXX(6)		; M
17700		MOVE	7,6	;Y=(Y-M)*1000.
17800		TLC	7,232000
17900		FADR	7,7	; FLOATS
18000		FSBR	5,7
18100		FMPR	5,[=1000.0]	; Y
18200		CAMG	5,[=100.0]	;IF(Y.GT.100.)Y=100-Y
18300		JRST 	RD4
18400		FSBR	5,[=100.0]
18500		MOVNS	5
18600	RD4:	FMPR	5,@3(16)
18700	;   Y NUMBERS .GT.100 ARE NEG.
18800		FADR	5,@5(16)	;B=Y*X+CENTR
18900		CAIG	6,=60		;IF(M.GT.60)M=100-M
19000		JRST	RD5
19100		SUBI	6,=100
19200		MOVNS	6
19300	RD5:	TLC	6,232000     ;	A=M*RMINI+R3
19400		FADR	6,6
19500		FMPR	6,@6(16)
19600		FADR	6,@4(16)
19700		MOVEM	6,A
19800		MOVEM	5,B
19900		MOVEM	2,RNOTE		;SAVE IT FOR A SECOND
20000		JSA	16,LINES	;2	CALL LINES(A,B,L)
20100		JUMP	A
20200		JUMP	B
20300		JUMP	L
20400		MOVE	2,RNOTE
20500		CAMGE	2,DRWNT
20600		AOJA	2,RD2
20700		JRA	16,7(16)
20800	
20900	CIRCLE:	0		;	RA=5.96*RSJT2*R5
21000		MOVE	RA,.COMM.+6
21100		FMPR	RA,[=5.96]
21200		FMPR	RA,STF+=8
21300		MOVE	RB,.COMM.+=29	;J8=J8*RDIS
21400		TLC	RB,232000	;FLOAT
21500		FADR	RB,RB
21600		FMPR	RB,PLTR+2
21700		MOVE	RX,.COMM.+=28	;IF(J7.LE.J6)J7=J7+360
21800		CAMLE	RX,.COMM.+=27	;RX IS J7
21900		JRST	C2
22000		ADDI	RX,=360
22100	C2:	MOVEI	RZ,6	;	KQ=6
22200		MOVE	2,PLTR		;IF(PLT)KQ=1
22300		SKIPGE	2
22400		MOVEI	RZ,1		
22500		MOVEM	RZ,DRWNT	; DRWNT IS KQ
22600	C10:	MOVE	KK,.COMM.+=27	;10	DO 3 K=J6,J7,KQ
22700		MOVEI	LL,3		;L=3
22800		MOVEM	LL,L
22900	C3:	MOVE	R,KK		;R=K
23000		TLC	R,232000
23100		FADR 	R,R
23200		MOVEM	R,A  ;CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
23300		JSA	16,SIND
23400		JUMP	A
23500		FMPR	0,RA
23600		FADR	0,.COMM.+4
23700		MOVEM	0,B
23800		JSA	16,COSD
23900		JUMP	A
24000		FMPR	0,RA
24100		FADR	0,.COMM.+2
24200		MOVEM	0,A
24300		JSA	16,LINES
24400		JUMP	B
24500		JUMP	A
24600		JUMP	L
24700		MOVEI	LL,2	;3	L=2
24800		MOVEM	LL,L
24900		ADD	KK,DRWNT
25000		CAIG	KK,(RX)
25100		JRST	C3 
25200		FSBR	RB,[1.0]	;J8=J8-1
25300		JUMPL	RB,SLR87	;IF(J8)RETURN
25400		MOVE	2,[1.0]		;RA=RA+1/RDIS
25500		FDVR	2,PLTR+2
25600		FADR	RA,2
25700		JRST 	C10		;GO TO 10
25800	;JA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
25900				;RETURN
26000	
26100	;;	SUBROUTINE PSRT(P)
26200	;; SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
26300	;;	IMPLICIT INTEGER(S-Z)
26400	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
26500	;;	DIMENSION  P(250) **** AN ARGUMENT, INSTEAD.
26600	MM←1↔NN←2↔J←3↔LL←4↔ AA←6↔Y←7↔V←10 ↔LX←12↔RN←13↔K←14
26700	PSRT:	0	;	DO 4 K=1,ITEM
26800		MOVEI	K,@(16)		; ADR OF P
26900		MOVEI	MM,PTR		;L=PWDS(K)
26950		MOVEI RB,(MM)
27000		MOVE	NN,PTR+=250	; ITEM
27100		ADDI	NN,-1(MM)		; LAST ADR. OF PWDS
27110		MOVE SY,[16.0]
27200	PL4:	MOVE	LX,(MM)
27300	;X	FIXX(LX)	
27400	;;;	MOVE	LL,-1(MM)	;LL=PWDS(K-1)
27500	;;;	FIXX(LL)
27600	;;;	MOVE	LM,1(MM)	;LM=PWDS(K+1)
27700	;;;	FIXX(LM)
27800	;;	MOVEI	RN,XRN		;A=RN(L+3)
27900	;;	ADDI	RN,(LX)
28000	;;	MOVE	AA,2(RN)		;(L+3)
28100	;;	MOVE	J,1(RN)		;P(K)=A+1000*RN(L+2)
28110		MOVE AA,XRN+2(LX)
28150		MOVE J,XRN+1(LX)
28200		FMPR	J,[=1000.0]
28300		FADR	J,XRN+2(LX)
28400	;;	MOVE	V,(RN)	; IF(RN(L+1).NE.16)GO TO 40
28450		MOVE V,XRN(LX)
28500		CAME	V,[=8.0]	;IF(RN(L+1).EQ.8)P(X)=P(X)-16
28600		JRST	PLA
28700		FSBR	J,[=16.0]
28800		MOVE	AA,[=1000.0]
28900	PLA:	MOVEM	J,(K)
29000	;;	CAME	V,[16.0]
29010		CAME V,SY
29100		JRST	PL40
29150		CAIN RB,(MM)
29175		JRST PLAQ		;IF (K.EQ.1) GO TO PLAQ
29200		MOVE	Y,-1(MM)	;Y=PWDS(K-1)
29650		CAMN SY,XRN(Y)
29800		JRST 	PL41
29900	PLAQ:	MOVE	V,1(MM)		;V=PWDS(K+1)
30000	;X	FIXX(V)
30100	;;	MOVEI	AA,XRN	; IF(RN(V+1).EQ.16)GO TO 41
30200	;;	ADDI	AA,(V)
30300	;;	MOVE	RN,(AA)
30350		CAMN SY,XRN(V)
30400	;;	CAMN	RN,[=16.0]
30500		JRST	PL41
30600		JRST	PLS		;GO TO 4
30700	PL40:	JUMPGE	AA,PLS 	;40	IF(A.GE.0)GO TO 4
30800	PL41:	MOVN	AA,[=10000.0]	;41	P(K)=-10000
30900		MOVEM	AA,(K)
31000	PLS:	CAIL	MM,(NN)	;4	CONTINUE
31100		JRST	PLX
31200		AOJ	MM,
31300		AOJA	K,PL4
31400	;  PLOTS ALL NEG. POSITIONS FIRST.
31500	PLX:	MOVE	AA,PTR+=252	;IX=I
31600		MOVEM	AA,PTR+=253
31700		CAIL	AA,=1500		;IF(I.LT.1500)I=1500
31800		JRST 	PLY
31900		MOVEI	AA,=1500
32000		MOVEM	AA,PTR+=252
32100	PLY:	MOVEI	Y,(AA)		;	Y=I
32200		ADD	AA,PTR+=253	;I=I+IX-1
32300		SUBI	AA,1
32400		MOVEM	AA,PTR+=252
32500		MOVEM	Y,PTR+=253	;IX=Y
32600	;  IX IS M IN MAIN PROG.
32700	;  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
32800	PL2:	MOVE	AA,@(16)		;2	A=P(1)
32900		MOVEI	LX,1		;L=1
33000		MOVEI	J,1
33100		MOVEI	K,@(16)		;DO 1 K=1,ITEM
33200		MOVE	NN,PTR+=250
33300		ADDI	NN,(K)	;P(ITEM)
33400	PL1:	CAMG	AA,(K)		;IF(A.LE.P(K))GO TO 1
33500		JRST	PLZ
33600		MOVE	AA,(K)		;A=P(K)
33700		MOVE	LX,J		;L=K
33800	PLZ:	CAIL	K,-1(NN)	;1	CONTINUE
33900		JRST	PLW
34000		AOJ	K,
34100		AOJA	J,PL1
34200	PLW:	CAMN	AA,[=10000.0]	;	IF(A.EQ.10000.)RETURN
34300		JRA	16,1(16)
34400	;  ALL ITEMS HAVE NOW BEEN SHUFFLED
34500		MOVEI	V,PTR		;V=PWDS(L)
34600		ADDI	V,(LX)
34700		MOVE	V,-1(V)
34800	;X	FIXX(V)
34900		MOVE	AA,[=10000.0]	;P(L)=10000
35000		MOVEI	J,@(16)
35100		ADDI	J,(LX)
35200		MOVEM	AA,-1(J)
35300		MOVEI	LX,XRN		;L=RN(V)+2+Y
35400		ADDI	LX,(V)
35500		MOVE	LX,-1(LX)
35600		FIXX(LX)
35700		ADDI	LX,2
35800		ADDI	LX,(Y)
35900		SUBI	V,(Y)		;V=V-Y
36000	;;	CALL LOOP(0,L,1,Y,V,RN)
36100		MOVEI	K,XRN		;DO 3 K=Y,L
36200		ADDI	K,(Y)
36300		MOVEI	NN,XRN
36400		ADDI	NN,(LX)
36500	PL3:	MOVEI	AA,(K)
36600		ADDI	AA,(V)		;3	RN(K)=RN(K+V)
36700		MOVE	AA,-1(AA)
36800		MOVEM	AA,-1(K)
36900		CAIGE	K,(NN)
37000		AOJA	K,PL3
37100	;; REPLACED SUBROUTINE LOOP
37200		MOVEI	Y,(LX)		;Y=L+1
37300		ADDI	Y,1
37400		JRST	PL2		;GO TO 2
37500	
37600	RUNTHR:	0	; CALL RUNTHR(M)
37700		MOVE	5,@(16)	;GET M
37800		MOVEI	2,XRN	;GET RN LOC.
37900		ADDI	2,(5)	;2=LOC OF RN(M+1)
38000		MOVE	3,-1(2)		;3=CNT
38100		FIXX(3)
38200		MOVE	4,(2)		;M+1
38300		FIXX(4)	
38400		MOVEM	4,.COMM.+1	;JA=RN(M+1)
38500		ADDI	5,2		;M=M+2
38600		ADDI	2,1		; LOC OF RN(M) NOW
38650		MOVE	6,(2)
38700		MOVEM	6,.COMM.	;R2=RN(M)	
38800		MOVEI	13,.COMM.	;LOC OF COMMON BLOCK
38900		SETZ	7,	;K=0
39000	LP:	MOVEI	12,.COMM.
39100		ADDI	12,(7)	
39200		CAML	7,3		;ARE WE PAST COUNT?
39300		JRST	LZRO		;YES
39400		MOVEI	10,(5)
39500		ADDI	10,(7)		;M+K
39600		MOVEI	11,XRN
39700		ADDI	11,(10)		;LOC OF RN(M+K)
39800		MOVE	11,(11)
39900		MOVEM	11,4(12)	;RJQ(K)=RN(M+K)
40000		FIXX(11)
40100		MOVEM	11,=24(12)	;JQ(K)=
40200		JRST	LB
40300	LZRO:	SETZM	4(12)		;RJQ(K)=0
40400		SETZM	=24(12)		;JQ(K)=0
40500	LB:	CAIE	7,=9	; LESS THAN 10?
40600		AOJA	7,LP
40700		ADDI	5,(3)	; M=CNT+M+1
40800		ADDI	5,1
40900		MOVEM	5,@(16)
41000		JRA	16,1(16)
41100	
41200		END